00100	C  TO JUSTIFY SEVERAL MSS FILES AT ONCE. (UP TO 10.)
00200		COMMON/Q/ RN(20000),PWDS(2500) ,RSTFAC(120),STFF(120),
00400		1 V(200),JR(120),P1,P2,I,M
00450	C  M=NUM OF STAVES. (BY 8S)
00500		COMMON JY,L,RJH,RJD,RDIS /RS/JW(120)
00550		
00700		TYPE 1
00800	1	FORMAT(' FILE NAME 1?  '$)
00900		ACCEPT 200,N1
01000	200	FORMAT(A5)
01100		TYPE 300
01200	300	FORMAT(' LAST NAME?  '$)
01300		ACCEPT 200,N2
01400		TYPE 100
01500	100	FORMAT(' POS.1, POS.2 -  '$)
01600		ACCEPT 111,P1,P2
01700	111	FORMAT(2F)
01800	CC	IF(P2.EQ.0)P2=200
01900	
01910		JW(1)=1
01920		JR(1)=1
02000		M=1
02100		L=0
02200		JX=1
02300		IX=1
02400		NX=1
02500		NM=N1
02600	40	CALL IFILE(1,NM)
02700		READ (1)J,I,
02800		1 (PWDS(K),K=JX,JX+J),(RN(K),K=IX,I+IX-2),ISCR,(V(K),K=1,ISCR),
02900		1 ISCR,(V(K),K=1,ISCR),(RSTFAC(K),K=NX,NX+7),(STFF(K),K=
03000		1 NX,NX+7),K
03100	
03200		IF(P1.EQ.999)GO TO 2
03210	C ********* TYPE 999 AS POS1. FOR 'CONVERT', NAME2 WILL BE OUTPUT NM.
03300		RX=NX-1
03500	
03600		DO 41 K=JX,JX+J
03700		PWDS(K)=PWDS(K)+L
03800		KX=PWDS(K)+3
03820	C  +3 IS FOR STAFF #
03840	41	RN(KX)=RN(KX)+RX
03900		IX=I+IX-1
03910		L=IX-1
04000		JX=J+JX
04010		JW(M+1)=JX
04020	C  POINTER TO START OF PWDS FOR EACH FILE
04030		JR(M+1)=IX  
04100		NX=NX+8
04200		IF(IX.LT.19500)GO TO 400
04300		RRT=IX
04400		TYPE 111,RRT
04500	400	IF(NM.EQ.N2)GO TO 5
04600		NM=NM+2
04700		M=M+1
04800		GO TO 40
04900	
05700	2	JJ=1
05800	3001	L=PWDS(JJ)
05900		K=L+1
06000		A=RN(K)
06010		Z=RN(L)
06100		IF(A.LT.5.OR.(A.GT.10.AND.A.NE.20))GO TO 3002
06300		IF(A.NE.6)GO TO 3003
06400		RN(K)=13
06500		GO TO 3002
06600	3003	IF(A.NE.5)GO TO 3004
06700		RN(K)=10
06800		IF(Z.LT.4)GO TO 3010
06900		X=RN(L+5)
07000		RN(L+5)=RN(L+6)
07100		RN(L+6)=X
07200		GO TO 3002
07300	3004	IF(A.NE.7)GO TO 3005
07400		RN(K)=17
07500		GO TO 3010
07600	3005	IF(A.EQ.8)RN(K)=5
07700		IF(A.EQ.9)RN(K)=6
07800		IF(A.NE.10)GO TO 3006
07900		RN(K)=8
08000	 	GO TO 3010
08100	3006	IF(A.EQ.20)RN(K)=7
08200		IF(A.NE.18)GO TO 3002
08300	3010	FORMAT(' ITEM ',I3,', CODE ',F3.0)
08400		TYPE 3010,JJ,A
08410	3002	A=RN(L+2)
08420		RN(L+2)=RN(L+3)
08430		RN(L+3)=A
08500		A=L+Z+3
08600		JJ=JJ+1
08700		IF(A.EQ.PWDS(JJ))GO TO 3001
10000		MX=1
10100		IF(N2.NE.' ')NM=N2
10200		GO TO 6
10300	
10400	5	I=JX-1
10500	C  TOTAL IN RN ('I' IN MXX.F4)
10600		CALL JJUST
10700	
10800	C  START OF WRITER
10810		NM='AAAAA'
10900	6	JX=1
11000		IX=1
11100		NX=1
11300		L=0
11400	
11600		MX=M
11700		M=1
11800		CALL OFILE(21,NM)
11900		IF(P1.EQ.999)GO TO 3
12000		J=JW(M+1)-JW(M)
12100		I=JR(M+1)-JR(M)+1
12200		P1=PWDS(JX+J)
12300		RX=NX-1
12400		DO 61 K=JX,JX+J
12500		KX=PWDS(K)
12600		PWDS(K)=KX-L
12700		KX=KX+3
12800	61	RN(KX)=RN(KX)-RX
12900	3	L=I+IX-2
13000		WRITE(21)J,I,
13100		1 (PWDS(K),K=JX,JX+J),(RN(K),K=IX,L),ISCR,(V(K),K=1,ISCR),
13200		1 ISCR,(V(K),K=1,ISCR),(RSTFAC(K),K=NX,NX+7),(STFF(K),K=
13300		1 NX,NX+7),K,K
13400		PWDS(JX+J)=P1
13500		TYPE 60,NM
13600	
13700		IF(M.EQ.MX)CALL EXIT
13800		M=M+1
13900		JX=JW(M)
14000		IX=JR(M)
14100	
14200		NX=NX+8
14300		END FILE 21
14400		NM=NM+2
14500		GO TO 6
14600	60	FORMAT(1XA5)
14700		END
14800	
14900		SUBROUTINE JJUST
15000		DATA RSP/.5/,RI/4.5/,RPX/.2/
15100		COMMON JY,L,RJH,RJD,RDIS
15200		COMMON/Q/ RN(20000),PWDS(2500) 
15300		1,RSTFAC(120),STFF(120),R(2,100),JR(120),P1,P2,I,M
15400	
15500		DIMENSION IR(2,100)
15600		EQUIVALENCE (R,IR)
15700		JJB=-1
15800		IX=PWDS(I+1)-1
15900		PRCNT=1.
16000		JB=0
16100		RRT=P2
16200		RZRO=P1
16300		RJD=P1
16400		IF(RRT.EQ.0)RRT=200
16500		IF(RZRO.EQ.0)RZRO=.001
16600		JCNT=0
16700		RJSZ=RI
16800	CC	RJF=0
16900		ML=1
17000		ROV=RRT
17100	19	IF(JCNT.GT.9)GO TO 101
17200		RJSZ=RJSZ-RPX	
17300		JCNT=JCNT+1
17400	C  TEMPORARY COUNTER
17500		TYPE 111,JCNT
17600	111	FORMAT(I4)
17700	
17800		DO 11 KN=-3,M*8-4
17900		RSPC=0
18000	CC	MQ=MOD(KN,8)
18100	CC	IF(MQ.EQ.0)MQ=8
18200	CC	MQ=MQ-4
18300	CC	RJH=MQ
18400		RJH=KN
18500		N=0
18600	
18700		DO 2 K=1,I
18800		L=PWDS(K)
18900		RA=RN(L+1)
19000		RB=RN(L+2)
19100		IF((RN(L+3).NE.RJH.AND.RA.NE.4)
19200		1 .OR.RB.LT.RZRO) GO TO 2
19300		IF(RA.EQ.1)GO TO 10
19400	27	IF(RA.GT.4.AND.RA.NE.18.AND.RA.NE.7)GO TO 2
19500		IF(RA.EQ.4.AND.RN(L).GT.2)GO TO 2
19600	C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
19700	10	N=N+1
19800		R(1,N)=RB
19900		IR(2,N)=L
20000		IF(N.EQ.100)GO TO 28
20100	C  ONLY TREATS 100 ITEMS AT A TIME.
20200	
20300	
20400	2	CONTINUE
20500	
20600		IF(N.EQ.0)GO TO 11
20700	28	KM=JFAC(L)
20800	C  SEE FUNCTION JFAC.  RSTFAC PNTR.
20900		DO 23 K=1,N
21000	23	IF(RN(IR(2,K)+1).NE.4)GO TO 24
21100	C  SKIPS IF ONLY BAR LINES ON THIS STAFF
21200		GO TO 11
21300	24	RSTJC=RSTFAC(KM*8+KN+4)*PRCNT
21400		CALL SORT2(R,N)
21500	
21600	C  JUMP IF LAST IS A BAR LINE.
21700		K=0
21800		JLDGR=0
21900	     	JX=0
22000	22	K=K+1
22100	122	L=IR(2,K)
22200		RA=RN(L+1)
22300		RB=0
22400		RX=RN(L+5)
22500		RY=1
22600		RW=AMOD(RN(L+4),100.)
22700		IF(RA.GT.1)GO TO 4
22800		RZ=RN(L+7)
22900		IF(LDGR.NE.JLDGR)JLDGR=0
23000		LDGR=0
23100		JY=K
23200		DO 32 JJ=JY+1,N+1
23300		K=JJ
23400	32	IF(R(1,JJ)-R(1,JJ-1).GT.RSP)GO TO 35
23500	C  FOUND HOW MANY MEMBERS TO CHORD.
23600	35	RB=0
23700		K=K-1
23800		RQ=0
23900		RD=0
24000	125	IF(AMOD(RN(L+4),200.).GT.60.)RY=.6
24100		DO 37 JJ=JY,K-1
24200		IF(RD.NE.0)GO TO 38
24300	C FINDS ONLY HIGH OR! LOW LED. LINE.
24400		JIR=IR(2,JJ)
24500		RW=AMOD(RN(JIR+4),100.)
24600		IF(RW.LE.11.AND.RW.GE.2)GO TO 38
24700		LDGR=-1
24800		IF(RW.GT.11)LDGR=1
24900		IF(JLDGR.EQ.LDGR)GO TO 36
25000		JLDGR=LDGR
25100	C LDGR IS FOR LEDGER LINES.
25200		GO TO 38
25300	36	RD=1.5
25400		RQ=RD
25500	38	IF(RB.GT.2)GO TO 222
25600	C  JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
25700		RZZ=RN(JIR+7)
25800		RE=RN(JIR+5)
25900		IF(RB.LT.2.AND.((AMOD(RZZ,10.).NE.0.AND.RE.LT.20).
26000		1 OR.RZZ.GE.10))RB=1.5+EXTEN(RZZ)
26100	C  SPACE FOR DOT OR TAIL(IF STEM UP)
26200		IF(ABS(RN(JIR+6)).EQ.10)RB=RB+2
26300	C  FOR CHORD TONES ON RIGHT OF STEM UP.
26400	C  LOOKS THROUGH ALL NOTES OF A CHORD.
26500	222	IF(AMOD(RE,10.).EQ.0)GO TO 37 
26600	C  JUMP IF NO ACCIS.
26700	425	RD=2*RY+EXTEN(RE)
26800		IF(RQ.GT.RD)RD=RQ
26900		RQ=RD
27000	C  FUNCT. EXTEN=AMOD(X,1.)*10.
27100	37 	CONTINUE
27200		IF(RY.NE.1)RB=RB-.5*RJSZ
27300	C  MINI NOTES NEED LESS SPACE
27400	25	IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJC
27500		GO TO 17
27600	4	IF(RA.NE.3)GO TO 29
27700		RB=3
27800		IF(RX.GT.100)RB=1.5
27900	C  CHECK ON SIZE NEEDED FOR CLEFS
28000	29	IF(RA.NE.4)GO TO 26
28100		RB=-RJSZ/2
28200		RD=.9
28300		GO TO 25
28400	26	IF(RA.NE.18)GO TO 30
28500		IF(RW.GT.9.OR.RX.GT.9)GO TO 31
28600	C  CHECKS FOR 2-DIGIT METERS
28700		RB=-1
28800		RD=1
28900		GO TO 25
29000	31	RB=2
29100		RD=3
29200		GO TO 25
29300	30	IF(RA.NE.7)GO TO 17
29400	CC	RB=2*(ABS(RW)-2)
29500		RB=2*(ABS(RW)-1)-2
29600		RD=2
29700		GO TO 25
29800	C  SPACES FOR CORRECT NUM OF ACCIS.
29900	17	RC=(RB+RJSZ)*RSTJC
30000	C  RJSZ=DEFAULT SIZE
30100		JX=JX+1
30200		R(2,JX)=RC
30300		R(1,JX)=R(1,K)
30400	3	IF(K.LT.N)GO TO 22
30500		RA=R(1,1)
30600		RB=R(2,1)
30700	
30800		DO 13 KX=2,JX
30900		RE=R(1,KX)
31000	C  POS. BEFORE SHIFTING
31100		IF(ABS(RE-RA).GT..5)GO TO 14
31200		IF(R(2,KX).GT.RB)GO TO 16
31300	C  SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
31400		GO TO 13
31500	CC	IF(RZZ.LE.RB)GO TO 13
31600	C  JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
31700	CC	RB=RZZ-RB
31800	14	RD=RA+RB-RE
31900		IF(RD.LE.0)GO TO 16
32000	C  THERE'S ENOUGH ROOM
32100	CC	RD=RA+RB-RE+RD
32200		RJD=RE+RSPC-.001
32300		RJE=1000
32400	C  MAYBE MORE? ↑↑↑↑↑
32500		RJH=RD
32600		RJI=0
32700		RSPC=RSPC+RD
32800	C  RSPC SAVES TOTAL SPACE ADDED
32900	C  GO EXPAND IT
33000		IF(R(2,KX).NE.0)GO TO 166
33100	16	RB=R(2,KX)
33200	13	RA=RE
33300	11	CONTINUE
33400	110	IF(ROV.LE.RRT+.01)GO TO 18
33500		IF(RJSZ.GT.4)RJSZ=4
33600		PRCNT=(ROV-RZRO)/(RRT-RZRO)
33700		RP=RJSZ/(RJSZ-RPX)
33800		TYPE 1111,PRCNT,RP
33900	1111	FORMAT(1X2F9.6)
34000		IF(PRCNT.GT.RP)GO TO 19
34100		RJD=RZRO
34200		RJE=ROV
34300		RJH=RZRO
34400		RJI=RRT-.001
34500	C  JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
34600		ML=2
34700		GO TO 66
34800	18	ML=3
34900		RJH=RRT
35000		RJI=RRT+2
35100	C  GOES BACK TO PICK UP DANGLING ITEMS(BEYOND RRT)
35200		RJD=RRT
35300		RJE=RVX
35400	166	JJB=-1
35500		JB=0
35600	66	JY=1
35700		IF(JCNT.EQ.1)RVX=ROV+2
35800	C  RVX SHOULD BE FARTHEST POINT TO RIGHT.
35900		L=JY
36000		IF(RJI.NE.0)RDIS=(RJI-RJH)/(RJE-RJD)
36100	
36200	6551	RB=RN(JY)
36300		JB=JB+1
36400	C  IF STAFF#>4, ALL STAVES ARE MOVED.
36500		RA=RN(JY+1)
36600	C SKIPS IF NOT SPECIAL CODE NUM.
36700		RN2=RN(JY+2)
36800		IF(RN2.GT.RJE)GO TO 7551
36900		RC=-1
37000		RD=0
37100		IF(RA.EQ.8.OR.RA.EQ.9.OR.RA.EQ.20)RD=-1
37200		IF(RA.EQ.4..OR.RD.OR.RN(JY+5).EQ.50)RC=0
37300	C RC=0 FOR CODES 4,8,9
37400		RN6=RN(JY+6)
37500		IF(RN2.GE.RJD)GO TO 9551
37600	      IF(RC.OR.(RC.EQ.0.AND.(RN6.LE.RJD.OR.RN6.GE.RJE)))GO TO 7551
37700	C RIGHT SIDE IS BEFORE OR AFTER MOVE AREA.
37800	9551	IF(JJB)JJB=JB
37900	C   (50=CRESC., DECRESC.)
38000		RQ6=RN6-RJE
38100		RX=0
38200		RV=0
38300		IF(RA.NE.9.OR.RB.LT.7)GO TO 21
38400		RX=RN(L+9)
38500		RY=RX-RJE
38600		RZ=RJD-RX
38700		IF(RN(L+10).LT.30)GO TO 221
38800		RW=RN(L+8)
38900		IF(RW.GE.RJD.AND.RW.LE.RJE)RV=-1
39000	221	IF(RY.AND.RZ)RX=-1
39100	C PARTIAL BEAM IS WITHIN MOVE AREA.
39200	21	IF(RJI.EQ.0)GO TO 2551
39300		IF(RN2.GE.RJD)CALL MVBX(RN,2)
39400		IF(RC)GO TO 7552
39500		IF(RA.EQ.4..AND.RB.LT.4)GO TO 7552
39600		IF(RQ6)CALL MVBX(RN,6)
39700	C  END POINT OUTSIDE OF MOVE RANGE NOT AFFECTED.
39800		IF(RA.NE.9)GO TO 7552
39900		IF(RX)CALL MVBX(RN,9)
40000		IF(RV)CALL MVBX(RN,8)
40100	C  ONLY TRUE WHEN RA=9
40200		GO TO 7552
40300	
40400	2551	IF(RN2.GE.RJD)RN2=RN2+RJH
40500		RN(L+2)=RN2
40600	      IF(RQ6.AND.(RD.OR.(RA.EQ.4.AND.RB.GT.3.)))RN(L+6)=RN(JY+6)+RJH
40700		IF(RX)CALL MVBEAM(RN,9,JY,L,RJH)
40800		IF(RV)CALL MVBEAM(RN,8,JY,L,RJH)
40900		IF(RN2.GT.ROV)ROV=RN2
41000	C ??? NOT YET FIXED FOR ENDS OF SLURS OR LINES
41100	7552	L=RB+3+L
41200	7551	JY=RB+3+JY
41300		L=JY
41400		IF(JY.LT.IX)GO TO 6551
41500		GO TO (16,18,101),ML
41600	C ↑↑↑↑↑↑????
41700	101	JJB=1
41800		END
41900		
42000	C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
42100		SUBROUTINE MVBEAM(R,I,JY,L,W)
42200	C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
42300		DIMENSION R(1)
42400		Y=R(JY+I)
42500		Z=ABS(Y)
42600		IF(Z.LT.100.)GO TO 1
42700	C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
42800		Y=AMOD(Y,100.)
42900		X=Y+W
43000		Z=Z-ABS(Y)+ABS(X)
43100	C  PUTS ALL INTO POSITIVE
43200		IF(X)Z=-Z
43300		GO TO 2
43400	1	Z=Y+W
43500	2	R(L+I)=Z
43600		END
43700	
43800		SUBROUTINE MVBX(R,I)
43900		COMMON JY,L,RJH,RJD,RDIS
44000		DIMENSION R(1)
44100		R(L+I)=RJH+(R(JY+I)-RJD)*RDIS
44200		END
44300	
44400		SUBROUTINE EXCH(X,Y)
44500		Z=X
44600		X=Y
44700		Y=Z
44800		END
44900		SUBROUTINE SORT2(RPOS,M)
45000		DIMENSION RPOS(2,1000)
45100		L=2
45200	3	J=-1
45300		RX=RPOS(1,L-1)
45400		DO 2 K=L,M
45500		IF(RPOS(1,K).GE.RX)GO TO 2
45600		RX=RPOS(1,K)
45700	C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
45800		J=K
45900	2	CONTINUE
46000		IF(J)GO TO 4
46100		K=L-1
46200		CALL EXCH(RPOS(1,K),RPOS(1,J))
46300		CALL EXCH(RPOS(2,K),RPOS(2,J))
46400	4	L=L+1
46500		IF(L.LE.M)GO TO 3
46600		END
46700	
46800		FUNCTION EXTEN(X)
46900		EXTEN=AMOD(X,1.)*10.
47000		END
47100	
47200		FUNCTION JFAC(L)
47300	C  FINDS RSTFAC POINTER
47400	CC	COMMON /RS/JW(80)
47500		COMMON/Q/ RN(20000),PWDS(2500) 
47600		1,RSTFAC(120),STFF(120),R(2,100),JR(120),P1,P2,I,M
47700		K=0
47800	1	K=K+1
47900		IF(L.GE.JR(K))GO TO 1
48000		JFAC=K-2
48100		END